﻿Imports System.Drawing
Public Class FrmFontHost
    Dim Families() As FontFamily
    Const TestString = "the quick brown fox jumps over the lazy dog"
    Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        FillSizes()
        Families = FontFamily.Families()
        cmbFont.DataSource = Families
        cmbFont.DisplayMember = "Name"
        lblFont.Text = TestString + vbCrLf + TestString.ToUpper
    End Sub
    Public Property Displayfont As Font
        Get
            If cmbFont.SelectedIndex = -1 Then
                Return GetFont(cmbFont.Tag)
            Else
                Return GetFont(Families(cmbFont.SelectedIndex))
            End If
        End Get
        Set(value As Font)
            cmbSize.Text = value.SizeInPoints
            cmbFont.Text = value.FontFamily.Name
            cmbFont.Tag = value.FontFamily
            SetFontStyle(value)
            AddHandler cmbFont.SelectedIndexChanged, AddressOf cmbFont_SelectedIndexChanged
            AddHandler cmbSize.SelectedIndexChanged, AddressOf cmbFont_SelectedIndexChanged
            AddHandler chkBold.CheckedChanged, AddressOf FontStyleChanged
            AddHandler chkITalic.CheckedChanged, AddressOf FontStyleChanged
            AddHandler chkUnderline.CheckedChanged, AddressOf FontStyleChanged
            PreviewFont()
        End Set
    End Property
    Private Sub SetFontStyle(Fn As Font)
        chkBold.Checked = Fn.Bold
        chkITalic.Checked = Fn.Italic
        chkUnderline.Checked = Fn.Underline
    End Sub
    Private Sub FillSizes()
        cmbSize.Items.Clear()
        For i = 6 To 40
            cmbSize.Items.Add(i)
        Next
    End Sub

    Private Sub cmbFont_MeasureItem(sender As Object, e As System.Windows.Forms.MeasureItemEventArgs) Handles cmbFont.MeasureItem
        Try
            Dim size As Single = 15
            Dim style As FontStyle
            'If Families(e.Index).IsStyleAvailable(FontStyle.Regular) Then
            '    style = FontStyle.Regular
            'ElseIf Families(e.Index).IsStyleAvailable(FontStyle.Italic) Then
            '    style = FontStyle.Italic
            'Else
            '    style = FontStyle.Bold
            'End If
            style = GetValidStyle(Families(e.Index))

            Using myFont As Font = New Font(Families(e.Index), size, style, GraphicsUnit.Point)
                e.ItemHeight = myFont.Height
            End Using
        Catch ex As Exception

        End Try

    End Sub

    Private Sub cmbFont_DrawItem(sender As Object, e As System.Windows.Forms.DrawItemEventArgs) Handles cmbFont.DrawItem
        Dim size As Single
        size = 15
        ' Draw the background of the item.
        e.DrawBackground()
        Try
            Dim style As FontStyle
            'If Families(e.Index).IsStyleAvailable(FontStyle.Regular) Then
            '    style = FontStyle.Regular
            'ElseIf Families(e.Index).IsStyleAvailable(FontStyle.Italic) Then
            '    style = FontStyle.Italic
            'Else
            '    style = FontStyle.Bold
            'End If
            style = GetValidStyle(Families(e.Index))

            Using myFont As Font = New Font(Families(e.Index), size, style, GraphicsUnit.Point)
                e.Graphics.DrawString(myFont.Name, myFont, System.Drawing.Brushes.Black, e.Bounds.X, e.Bounds.Y)
            End Using
        Catch ex As Exception

        End Try
        ' Draw the focus rectangle if the mouse hovers over an item.
        e.DrawFocusRectangle()
    End Sub

    Private Sub PreviewFont()
        Dim index As Integer = cmbFont.SelectedIndex
        Dim fnt As Font = GetFont(Families(index))
        lblFont.Font = fnt
        Me.Width = Me.CreateGraphics().MeasureString(TestString.ToUpper, fnt, 5000).Width + 30
        Me.Height = fnt.Height * 3.5 + 50
    End Sub

    Private Function GetValidStyle(Fam As FontFamily) As FontStyle
        Dim style As FontStyle
        If Fam.IsStyleAvailable(FontStyle.Regular) Then
            style = FontStyle.Regular
        ElseIf Fam.IsStyleAvailable(FontStyle.Italic) Then
            style = FontStyle.Italic
        ElseIf Fam.IsStyleAvailable(FontStyle.Bold) Then
            style = FontStyle.Bold
        End If
        Return style
    End Function

    Private Function GetFont(Fam As FontFamily) As Font
        Dim style As FontStyle
        style = GetValidStyle(Fam)
        If Fam.IsStyleAvailable(FontStyle.Italic) AndAlso chkITalic.Checked Then
            If (style And FontStyle.Italic) <> FontStyle.Italic Then style += FontStyle.Italic
        End If
        If Fam.IsStyleAvailable(FontStyle.Bold) AndAlso chkBold.Checked Then
            If (style And FontStyle.Bold) <> FontStyle.Bold Then style += FontStyle.Bold
        End If
        If Fam.IsStyleAvailable(FontStyle.Underline) AndAlso chkUnderline.Checked Then
            If (style And FontStyle.Underline) <> FontStyle.Underline Then style += FontStyle.Underline
        End If
        Dim fnt As New Font(Fam, CInt(cmbSize.Text), style, GraphicsUnit.Point)
        Return fnt
    End Function


    Private Sub cmbFont_SelectedIndexChanged(sender As System.Object, e As System.EventArgs)
        If IsNumeric(cmbSize.Text) And cmbFont.SelectedIndex >= 0 Then
            PreviewFont()
        End If
    End Sub

    Private Sub FontStyleChanged(sender As System.Object, e As System.EventArgs)
        If IsNumeric(cmbSize.Text) And cmbFont.SelectedIndex >= 0 Then
            PreviewFont()
        End If
    End Sub

End Class